home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_geomview.idb / usr / freeware / lib / geomview / modules / tcl / Crayola.z / Crayola
Encoding:
Text File  |  1999-01-26  |  3.0 KB  |  107 lines
  1. #   Copyright (c) 1995 The Geometry Center; University of Minnesota
  2. #   1300 South Second Street;  Minneapolis, MN  55454, USA;
  3. #   
  4. # This file is part of geomview/OOGL. geomview/OOGL is free software;
  5. # you can redistribute it and/or modify it only under the terms given in
  6. # the file COPYING, which you should have received along with this file.
  7. # This and other related software may be obtained via anonymous ftp from
  8. # geom.umn.edu; email: software@geom.umn.edu.
  9.  
  10. # Author: Timothy Rowley
  11.  
  12.  
  13. # set up nicer-looking gray colors
  14.  
  15. catch { tk_bisque }
  16.  
  17. #set tk_strictMotif 1
  18. #option add *Background gray70 userDefault
  19. #option add *Foreground gray20 userDefault
  20. #option add *Checkbutton.selector yellow userDefault
  21. #option add *Radiobutton.selector yellow userDefault
  22. #. configure -background gray70
  23.  
  24.  
  25. proc newColor {} {
  26.     foreach p {r g b} {
  27.     append color [format %02x [expr int([.crayola.c.$p.s get]*255.999)]]
  28.     }
  29.     .crayola.swatch configure -background "#$color"
  30. }
  31.  
  32. proc setsliders {which abc} {
  33.   foreach i {0 1 2} {
  34.     set p [string range $which $i $i]
  35.     set cmd [.crayola.c.$p.s cget -command]
  36.     .crayola.c.$p.s configure -command {}
  37.     .crayola.c.$p.s set [lindex $abc $i]
  38.     if {$cmd != ""} {after idle .crayola.c.$p.s configure -command $cmd}
  39.   }
  40. }
  41.  
  42. proc newRGB {args} {
  43.     crayolaSetColor [.crayola.c.r.s get] [.crayola.c.g.s get] [.crayola.c.b.s get]
  44.     newColor
  45. }
  46.  
  47. proc newHSV {args} {
  48.     crayolaSetColor -hsv [.crayola.c.h.s get] [.crayola.c.s.s get] [.crayola.c.v.s get]
  49.     newColor
  50. }
  51.  
  52. proc mkCrayola {} {
  53.     global operation
  54.  
  55.     toplevel .crayola
  56.     set w .crayola
  57.     wm title $w Crayola
  58.     $w configure -borderwidth 2 -relief raised
  59.  
  60.     frame $w.col
  61.     frame $w.s -borderwidth 3 -relief sunken
  62.     frame $w.swatch -height 30
  63.     frame $w.c
  64.     foreach p {r g b h s v} {
  65.     frame $w.c.$p
  66.     label $w.c.$p.l -text [string toupper $p]
  67.     if {[string match {[rgb]} $p]} {
  68.         set cmd newRGB
  69.     } else {
  70.         set cmd newHSV
  71.     }
  72.     scale $w.c.$p.s -orient horizontal -from 0 -to 1 -resolution 0 -showvalue no -command $cmd
  73.     pack $w.c.$p.l $w.c.$p.s -in $w.c.$p -side left -fill y
  74.     pack $w.c.$p -side top 
  75.     }
  76.     frame $w.c.gap
  77.     pack $w.c.gap -after $w.c.b -pady 3
  78.     pack $w.swatch -in $w.s -fill x
  79.     pack $w.s $w.c -in $w.col -side top -expand 1 -fill x
  80.  
  81.     frame $w.buttons
  82.     set b $w.buttons
  83.     frame $b.bot
  84.  
  85.     set operation get
  86.     radiobutton $b.b1 -text "Get" -value get -variable operation \
  87.     -indicatoron false
  88.     radiobutton $b.b2 -text "Set" -value set -variable operation \
  89.     -indicatoron false
  90.     radiobutton $b.b3 -text "Set all" -value setall -variable operation \
  91.     -indicatoron false
  92.     radiobutton $b.b4 -text "Eliminate Color" -value eliminate \
  93.     -variable operation -indicatoron false
  94.  
  95.     button $b.b5 -text "Undo!" -command crayolaUndo
  96.     button $b.b6 -text "Quit" -command crayolaQuit
  97.     pack $b.b1 $b.b2 $b.b3 $b.b4 -fill x
  98.     pack $b.b5 $b.b6 -in $b.bot -fill x
  99.     pack $b.bot -expand 1 -fill x
  100.  
  101.     pack $w.col $w.buttons -side left -fill y -padx 2 -pady 2
  102. }
  103.  
  104. wm withdraw .
  105. mkCrayola
  106. emodule_init crayola
  107.